Présentation du document

NB : Ce script est un document de travail.

Il cherche à objectiver, par l’utilisation de méthodes d’analyse spatiale, l’« effet de grappe » repéré par la littérature (Bideau 2019)

Il est mis à disposition dans une logique de science ouverte.

Ce travail s’inscrit dans le cadre d’une étude plus générale sur les communes nouvelles (et plus particulièrement d’un addendum au chapitre IV de la thèse) :

https://cv.hal.science/gabriel-bideau

Licence CC-BY-NC-SA.

Il est possible d’accéder au code de ce Markdown ici : https://gbideau.github.io/CN_effet_de_grappe/effet_de_grappe.Rmd

Les données utilisées pour jouer le code sont regroupées ici : https://gbideau.github.io/CN_data/

Ne pas hésiter à contacter l’auteur () pour toute question.

Packages nécessaires

# Librairies utilisées
library(sf)
library(cartography)
library(mapsf)
library(corrplot)
library(cowplot)
library(MTA)
library(readxl)
library(ggplot2)
library(FactoMineR) 
library(factoextra)
library(cluster)
library(reshape)
library(reshape2)
library(flows)
# NB : Pour le package flows, la version la plus récente est disponible ici :
# remotes::install_github("rCarto/flows") # ou # install.packages("mapsf")
# Pour obtenir une version plus ancienne (celle utilisée ici) : https://cran.r-project.org/src/contrib/Archive/flows/
# install.packages("packages/flows_1.1.1.tar.gz", repos=NULL, type="source")
library(sp)
library(knitr)
library(condformat) # https://cran.r-project.org/web/packages/condformat/vignettes/introduction.html
library(units)
library(stringr)
# library(dplyr)
library(questionr)
library(spdep) # Pour les matrices de contiguïté
library(rgeoda) # Pour les matrices de contiguïté

# Liste pour installer les packages si besoin :
# sf cartography mapsf readxl foreign dplyr flextable knitr stringr units condformat forcats ggplot2 rstatix questionr corrplot gtsummary broom GGally effects forestmodel ggeffects labelled cowplot spdep rgeoda

Matrice de contiguïté et autocorrélation spatiale

Import des données

load("data/refdata.Rdata")

geom2011 <- st_read("data/geom.gpkg", layer = "geom2011", quiet = TRUE) 
geom_new <- st_read("data/geom.gpkg", layer = "geom_new", quiet = TRUE) 

Il s’agit ici de creuser l’« effet de grappe », ce qu’on appelle parfois l’« effet consultant ».

Matrice de voisinage (package spdep)

À l’aide de Bellefon, Loonis, and Le Gleut (2018).

library(spdep)

test_geom <- merge(geom2011, df2011[, c("CODGEO", "CODE_DEPT", "COM_NOUV", "P09_POP", "LIBGEO")], by = "CODGEO")
test_geom <- subset (test_geom, CODE_DEPT == "49" )

test_queen <- poly2nb(test_geom, queen = TRUE)
test_rook <- poly2nb(test_geom, queen = FALSE)

# On change de type d'objet pour faciliter les représentations
test_geom <- as(test_geom, "Spatial")

# Représentation graphique des deux manières de calculer les voisinages.
# plot(test_geom, border="lightgray")
# plot(test_geom, border="grey50")
# 
# plot(test_queen, coordinates(test_geom),add=TRUE,col="red")
# plot(test_rook, coordinates(test_geom),add=TRUE,col="blue")

# Représentation graphique des deux manières de calculer les voisinages dans le cas du département du Maine-et-Loire
plot(test_geom, border="grey50", main = "Le voisinage des communes\ndans le département du Maine-et-Loire (49)",
     cex.main=1, # taille titre
     font.main=1, # type (1 : normal, 2 : gras)
     )
plot(test_queen, coordinates(test_geom),add=TRUE,col="red")
plot(test_rook, coordinates(test_geom),add=TRUE,col="blue")
legend(title = "Type de voisinage", x="bottomright", legend=c("« Tour » et « Reine »","Uniquement « Reine »"), col=c("blue","red"),
       lty=1, # type de figuré dans la légende
       cex=0.7, # taille légende
       box.lty=0, # supprime bordure
       bg=NA # Pas de couleur en arrière-plan de la légende
       )

# Réalisation d'une liste de poids
test_liste <- nb2listw(test_queen, zero.policy = TRUE)
# NB : zero.policy :default NULL, use global option value; if FALSE stop with error for any empty neighbour sets, if TRUE permit the weights list to be formed with zero-length weights vectors https://r-spatial.github.io/spdep/reference/nb2listw.html

# Pour avoir une représentation graphique des communes nouvelles
test_geom2 <- merge(geom2011, df2011[, c("CODGEO", "CODE_DEPT", "COM_NOUV", "P09_POP", "LIBGEO")], by = "CODGEO")
test_geom2 <- subset (test_geom2, CODE_DEPT == "49" )

plot(subset(test_geom2[, c("CODE_DEPT", "COM_NOUV")], CODE_DEPT == "49"))

# Pour extraire les entités sans liens :
test_liste$neighbours
## Neighbour list object:
## Number of regions: 363 
## Number of nonzero links: 2012 
## Percentage nonzero weights: 1.526915 
## Average number of links: 5.5427
isol <- test_geom2[c(5896, 7662, 10958, 10959, 10960, 11024, 21454, 21470, 21471, 21472, 21473, 33974),]


rm(isol, test_queen, test_rook)

À l’échelle du département du Maine-et-Loire, des différences notables en fonction du voisinage choisi.

Officiellement, le contact par un point autorise à fusionner en commune nouvelle donc choix du voisinage “queen”.

Cf. la réponse du ministère de l’intérieur à une question écrite au Sénat sur la question de la continuité territoriale en 2009 : https://www.senat.fr/questions/base/2009/qSEQ090609011.html.

Calcul de l’indice de Moran (package spdep)

Cf. Bellefon and Salima (2018) p. 56 sq. pour l’explication et 62 pour le code.

test_geom$COM_NOUV2 <- dplyr::if_else(test_geom$COM_NOUV == "OUI", 1, 0)

moran.plot(test_geom$COM_NOUV2, test_liste, labels=FALSE , xlab="variable",ylab="moyenne des voisins")

moran.plot(test_geom$P09_POP, test_liste, labels=FALSE , xlab="variable",ylab="moyenne des voisins")

Statistiques join count (package spdep)

Cf. Bellefon and Salima (2018) p. 62 sq. pour l’explication et 64 pour le code.

L’analyse des statistiques des join count observe, pour une variable binaire, s’il y a une autocorrélation spatiale de la présence d’individus partageant ou non une caractéristique. “on considère une variable binaire qui représente deux couleurs, Blanc (B) et Noir (N) de sorte qu’une liaison puisse être qualifiée de Blanc-Blanc, Noir-Noir ou Blanc-Noir. On observe :

une autocorrélation spatiale positive si le nombre de liaisons Blanc-Noir est significativement inférieur à ce que l’on aurait obtenu à partir d’une répartition spatiale aléatoire ;

une autocorrélation spatiale négative si le nombre de liaisons Blanc-Noir est significativement supérieur à ce que l’on aurait obtenu à partir d’une répartition spatiale aléatoire ;

aucune autocorrélation spatiale si le nombre de liaisons Blanc-Noir est approximativement identique à ce que l’on aurait obtenu à partir d’une répartition spatiale aléatoire.” (p. 62-63, souligné dans le texte)

test_geom$COM_NOUV3 <- as.factor(test_geom$COM_NOUV)
class(test_geom$COM_NOUV3)
## [1] "factor"
joincount.test(test_geom$COM_NOUV3, test_liste, zero.policy=TRUE, alternative="greater",
 sampling="nonfree", spChk=NULL, adjust.n=TRUE)
## 
##  Join count test under nonfree sampling
## 
## data:  test_geom$COM_NOUV3 
## weights: test_liste 
## 
## Std. deviate for NON = 12.114, p-value < 2.2e-16
## alternative hypothesis: greater
## sample estimates:
## Same colour statistic           Expectation              Variance 
##             44.663005             26.113260              2.344626 
## 
## 
##  Join count test under nonfree sampling
## 
## data:  test_geom$COM_NOUV3 
## weights: test_liste 
## 
## Std. deviate for OUI = 11.408, p-value < 2.2e-16
## alternative hypothesis: greater
## sample estimates:
## Same colour statistic           Expectation              Variance 
##             89.519769             69.613260              3.045139

Pour les communes nouvelles, on observe une autocorrélation positive très nette et significative. L’autocorrélation est d’ailleurs également significtive pour les communes non fusionnantes, même si la déviation est moins nette.

LISA : Indice de Moran (package spdep)

Mesures locales d’association spatiale : LISA (Local Indicators of Spatial Association).

Cf. Bellefon and Salima (2018) p. 65 sq. pour l’explication et 69 pour le code.

“Anselin (ANSELIN 1995) développe les notions introduites par Getis et Ord en définissant des indicateurs d’autocorrélation spatiale locale. Ceux-ci doivent permettre de mesurer l’intensité et la significativité de la dépendance locale entre la valeur d’une variable dans une unité spatiale et les valeurs de cette même variable dans les unités spatiales environnantes.” (p. 65)

Fonction ‘localmoran’ du package ‘spdep’. Ii : local moran statistic ; E.Ii : expectation of local moran statistic ; Var.Ii : variance of local moran statistic ; Z.Ii : standard deviate of local moran statistic ; Pr() : p-value of local moran statistic (https://www.rdocumentation.org/packages/spdep/versions/1.1-8/topics/localmoran).

Pour analyser correctement la représentativité des résultats, plusieurs méthodes proposent d’ajuster la p-value :

“On considère que cette méthode [celle de Bonferroni] ne donne de bons résultats que lorsque le nombre de tests réalisés est petit. […] La méthode d’ajustement de Holm conduit à un plus grand nombre de clusters significatifs que la méthode de Bonferroni. Elle lui est donc le plus souvent préférée. Cependant, cette méthode se concentre aussi sur la détection de l’existence d’au moins un cluster dans toute la zone. […] La méthode du False Discovery Rate (FDR) a été introduite par BENJAMINI et al. 1995. Avec cette méthode, le risque de juger - à tort - un cluster comme significatif est plus élevé, mais inversement le risque de juger - à tort - un cluster comme non significatif est plus faible.” (p. 68) “La méthode de Holm diminue en effet le risque de conclure à tort à l’existence d’une autocorrélation spatiale locale. En revanche, cette méthode augmente le risque de passer à côté d’un cluster local.” (p.69)

results_LISA<- as.data.frame(localmoran(test_geom$COM_NOUV2,test_liste,zero.policy=TRUE))

#Calcul des p-values ajustées
results_LISA$pvalue_ajuste_bonferroni<- p.adjust(results_LISA$`Pr(z != E(Ii))`,method="bonferroni")
results_LISA$pvalue_ajuste_holm<- p.adjust(results_LISA$`Pr(z != E(Ii))`,method="holm")
results_LISA$pvalue_ajuste_fdr<- p.adjust(results_LISA$`Pr(z != E(Ii))`,method="fdr")

test_geom3 <- cbind(test_geom2, results_LISA)


# Quelles communes ont une p-value élevée selon les trois méthodes ?
par(mar = c(0,0,0,0), mfrow = c(2,2))

# plot(st_geometry(dep), col = NA)
choroLayer(x = test_geom3 , var = "pvalue_ajuste_holm",
           method = "quantile", nclass = 6,
           # col = carto.pal(pal1 = "blue.pal", pal2 = "red.pal", n1 = 3, n2 = 3),
           col = carto.pal(pal1 = "blue.pal", n1 = 6),
           border = NA,
           legend.pos = "topleft", legend.values.rnd = 2,
           legend.title.txt = "Pvalue ajustée : méthode de Holm")


choroLayer(x = test_geom3 , var = "pvalue_ajuste_bonferroni",
           method = "quantile", nclass = 6,
           # col = carto.pal(pal1 = "blue.pal", pal2 = "red.pal", n1 = 3, n2 = 3),
           col = carto.pal(pal1 = "blue.pal", n1 = 6),
           border = NA,
           legend.pos = "topleft", legend.values.rnd = 2,
           legend.title.txt = "Pvalue ajustée : méthode de Bonferroni")

choroLayer(x = test_geom3 , var = "pvalue_ajuste_fdr",
           method = "quantile", nclass = 6,
           # col = carto.pal(pal1 = "blue.pal", pal2 = "red.pal", n1 = 3, n2 = 3),
           col = carto.pal(pal1 = "blue.pal", n1 = 6),
           border = NA,
           legend.pos = "topleft", legend.values.rnd = 2,
           legend.title.txt = "Pvalue ajustée : méthode FDR")


typoLayer(x = test_geom3, var = "COM_NOUV",  
          col=c("red", "blue"), border = NA)

layoutLayer(title = "Titre", theme = "red.pal",
            author = "G. Bideau, 2022.",
            sources = "")

# On choisit la méthode FDR et on ne conserve que les valeurs qui nous paraissent significatives au vu de la p-value ainsi ajustée

test_geom3$Ii_retenu <- ifelse(test_geom3$pvalue_ajuste_fdr <= 0.1, yes = test_geom3$Ii, no = NA)

par(mar = c(0,0,0,0), mfrow = c(1,2))

# On cartographie le résultat de l'indice de Moran

choroLayer(x = test_geom3 , var = "Ii_retenu",
           method = "quantile", nclass = 6,
           # col = carto.pal(pal1 = "blue.pal", pal2 = "red.pal", n1 = 3, n2 = 3),
           col = carto.pal(pal1 = "blue.pal", n1 = 6),
           legend.pos = "topleft", legend.values.rnd = 2,
           legend.title.txt = "Indices de Moran significatifs",
           legend.nodata = "p-value non significatif (>0,1 méthode FDR)")
typoLayer(x = test_geom3, var = "COM_NOUV",  
          col=c("red", "blue"), border = NA, legend.pos = "topleft")

par(mar = c(0,0,0,0), mfrow = c(1,1))

Matrice de voisinage (package rgeoda)

Présentation du package ‘rgeoda’ : https://geodacenter.github.io/rgeoda/articles/rgeoda_tutorial.html

Sur les matrices de contiguïté : https://geodacenter.github.io/workbook/4a_contig_weights/lab4a.html

Sur l’auto-corrélation : http://geodacenter.github.io/workbook/6a_local_auto/lab6a.html

library(rgeoda)


test_geom <- merge(geom2011, df2011[, c("CODGEO", "CODE_DEPT", "COM_NOUV", "P09_POP")], by = "CODGEO")
# test_geom <- subset (test_geom, CODE_DEPT == "49" )
test_geomCN <- merge(geom_new, df_new, by = "CODGEO_new")
test_geomCN <- subset(test_geomCN, COM_NOUV == "OUI")

queen_w <- queen_weights(test_geom, order=1, include_lower_order = FALSE, precision_threshold = 0)
summary(queen_w)
##                      name                value
## 1 number of observations:                36208
## 2          is symmetric:                  TRUE
## 3               sparsity: 0.000164767983149941
## 4        # min neighbors:                    0
## 5        # max neighbors:                   29
## 6       # mean neighbors:     5.96591913389306
## 7     # median neighbors:                    6
## 8           has isolates:                 TRUE
# Pour savoir si certaines entités sont séparées des autres
has_isolates(queen_w)
## [1] TRUE

LISA (package rgeoda)

NB : Sous-section qui peut poser problème lors d’un knit si n’est pas executée en même temps que les précédentes (cela ne fonctionne pas bien si les sous-sections précédentes sont en cache).

test_geom$COM_NOUV2 <- dplyr::if_else(test_geom$COM_NOUV == "OUI", 1, 0)
variable <- "COM_NOUV2"
df_variable <- test_geom[variable]
lisa <- local_moran(queen_w, df_variable)

# To get the values of the local Moran:
lms <- lisa_values(gda_lisa = lisa)

# To get the pseudo-p values of significance of local Moran computation:
pvals <- lisa_pvalues(lisa)

# To get the cluster indicators of local Moran computation:
cats <- lisa_clusters(lisa, cutoff = 0.05)

# Labels
lbls <- lisa_labels(lisa)


test_geom$LISA <- lms
test_geom$pvals <- pvals
test_geom$cats <- cats

# On rend les catégories plus lisibles en remplaçant le numéro par l'intitulé
test_geom$cats <- as.factor(test_geom$cats)
num_levels <- as.numeric(levels(test_geom$cats))
levels(test_geom$cats) <- lbls[num_levels + 1]
print(levels(test_geom$cats))
## [1] "Not significant" "High-High"       "Low-High"        "High-Low"       
## [5] "Isolated"
test_geom$LISA_retenu <- ifelse(test_geom$pvals <= 0.1, yes = test_geom$LISA, no = NA)

par(mar = c(0,0,0,0), mfrow = c(1,2))

couleurs <- c("#f7f7f7", "#e41a1c","#377eb8","#4daf4a","#984ea3","#ff7f00","#ffff33")
# Cf. https://colorbrewer2.org/#type=qualitative&scheme=Set1&n=6 pour composer les palettes
typoLayer(x = test_geom , var = "cats",
           # col = carto.pal(pal1 = "blue.pal", pal2 = "red.pal", n1 = 3, n2 = 3),
           col = couleurs[1:length(levels(test_geom$cats))],
           # border = NA,
           border = "grey70", lwd = 0.1,
           legend.pos = "topleft",
           legend.values.order = levels(test_geom$cats),
           legend.title.txt = "Indices de Moran significatifs\nsur la variable « commune nouvelle »\n(pvalue < 0,05)")


typoLayer(x = test_geom, var = "COM_NOUV",
          legend.values.order = c("OUI", "NON"),
          col=c("red","blue"),
          border = NA,
          legend.pos = "topleft",
          legend.title.txt = "Communes fusionnantes")

# plot(test_geomCN$geometry, col = NA, border = "black", lwd = 1, add = TRUE)

par(mar = c(0,0,0,0), mfrow = c(1,1))

table(test_geom$cats, test_geom$COM_NOUV)
##                  
##                     NON   OUI
##   Not significant 31245   992
##   High-High           0  1576
##   Low-High         2380     0
##   High-Low            0     3
##   Isolated           12     0
rm(variable, df_variable, lms, pvals, cats, lbls, num_levels, couleurs)

LISA (package rgeoda) autres variables

NB : Sous-section qui peut poser problème lors d’un knit si n’est pas executée en même temps que les précédentes (cela ne fonctionne pas bien si les sous-sections précédentes sont en cache).

L’objectif de cette sous-section est d’observer si on observe une différence entre communes fusionnantes et autres communes, du point de vue de l’auto-corrélation spatiale de certains indicateurs.

Globalement, on observe bien des positionnements parfois un peu différents des communes fusionnantes, mais cela est sans doute davantage lié à des effets de contexte (les communes fusionnantes sont sur-représentés dans certains types d’endroits, sous-représentés dans d’autres) que réellement lié à ces clusters.

test_geom$COM_NOUV2 <- dplyr::if_else(test_geom$COM_NOUV == "OUI", 1, 0)
variable <- "COM_NOUV2"
colnames(df2011)
##  [1] "CODGEO"                 "LIBGEO"                 "CODE_DEPT"             
##  [4] "CATAEU2010"             "REG"                    "ARR"                   
##  [7] "CV"                     "UU2010"                 "AU2010"                
## [10] "ZE2010"                 "EPCI"                   "P09_ACT1564"           
## [13] "P09_CHOM1564"           "P09_ETUD1564"           "P09_RETR1564"          
## [16] "C09_ACT1564_Agr"        "C09_ACT1564_ArtCom"     "C09_ACT1564_Cadr"      
## [19] "C09_ACT1564_ProfInt"    "C09_ACT1564_Empl"       "C09_ACT1564_Ouvr"      
## [22] "P09_EMPLT"              "C09_EMPLT_AGRI"         "C09_EMPLT_INDUS"       
## [25] "C09_EMPLT_CONST"        "C09_EMPLT_CTS"          "C09_EMPLT_APESAS"      
## [28] "P09_ACTOCC"             "P09_POP"                "P09_POP0014"           
## [31] "P09_POP1529"            "P09_POP3044"            "P09_POP4559"           
## [34] "P09_POP6074"            "P09_POP75P"             "C09_ACTOCC_IN"         
## [37] "C09_ACTOCC_OUT"         "C09_ACTOCC"             "P11_POT_FIN"           
## [40] "P11_DGF"                "P11_FoyFisc"            "P11_Rev_Fisc"          
## [43] "P11_IMP_NET"            "P11_FoyFisc_Imp"        "superficie"            
## [46] "CIF_2012"               "CIF_2015"               "ZAU_POL"               
## [49] "ZAU_RUR"                "ZAU_MAR_SP"             "ZAU_MAR"               
## [52] "ZAU_PERI"               "ZAU_AU"                 "FUSION"                
## [55] "ChefLieu"               "ComDLG"                 "FusDate"               
## [58] "FusPhas"                "COM_NOUV"               "CODGEO_new"            
## [61] "LIBGEO_new"             "P09_CHOM1564_RT"        "P09_ETUD1564_RT"       
## [64] "P09_RETR1564_RT"        "C09_ACT1564_Agr_RT"     "C09_ACT1564_ArtCom_RT" 
## [67] "C09_ACT1564_Cadr_RT"    "C09_ACT1564_ProfInt_RT" "C09_ACT1564_Empl_RT"   
## [70] "C09_ACT1564_Ouvr_RT"    "C09_EMPLT_AGRI_RT"      "C09_EMPLT_INDUS_RT"    
## [73] "C09_EMPLT_CONST_RT"     "C09_EMPLT_CTS_RT"       "C09_EMPLT_APESAS_RT"   
## [76] "P09_POP0014Y_RT"        "P09_POP1529Y_RT"        "P09_POP3044Y_RT"       
## [79] "P09_POP4559Y_RT"        "P09_POP6074Y_RT"        "P09_POP75PY_RT"        
## [82] "C09_ACTOCC_IN_RT"       "C09_ACTOCC_OUT_RT"      "C09_EMP_CONC_RT"       
## [85] "P11_POT_FIN_RT"         "P11_DGF_RT"             "P11_Rev_Fisc_RT"       
## [88] "P11_IMP_NET_RT"         "P11_FoyFisc_Imp_RT"
variable <- "P11_POT_FIN"
variable <- "P09_POP1529Y_RT"
variables_a_tester <- c("P09_CHOM1564", "C09_EMPLT_AGRI","P09_POP0014", "P09_POP1529", "P09_POP6074", "C09_ACTOCC_OUT", "superficie", "P11_POT_FIN")

for (variable in variables_a_tester) {

test_geom2 <- merge(test_geom, df2011[, c("CODGEO", variable)], by = "CODGEO")
colnames(test_geom2)
df_variable <- test_geom2[variable]
lisa <- local_moran(queen_w, df_variable)

# To get the values of the local Moran:
lms <- lisa_values(gda_lisa = lisa)

# To get the pseudo-p values of significance of local Moran computation:
pvals <- lisa_pvalues(lisa)

# To get the cluster indicators of local Moran computation:
cats <- lisa_clusters(lisa, cutoff = 0.05)

# Labels
lbls <- lisa_labels(lisa)


test_geom2$LISA <- lms
test_geom2$pvals <- pvals
test_geom2$cats <- cats

# On rend les catégories plus lisibles en remplaçant le numéro par l'intitulé
test_geom2$cats <- as.factor(test_geom2$cats)
num_levels <- as.numeric(levels(test_geom2$cats))
levels(test_geom2$cats) <- lbls[num_levels + 1]
print(levels(test_geom2$cats))

test_geom2$LISA_retenu <- ifelse(test_geom2$pvals <= 0.1, yes = test_geom2$LISA, no = NA)

par(mar = c(0,0,0,0), mfrow = c(1,2))

couleurs <- c("#f7f7f7", "#e41a1c","#377eb8","#4daf4a","#984ea3","#ff7f00","#ffff33")
# Cf. https://colorbrewer2.org/#type=qualitative&scheme=Set1&n=6 pour composer les palettes
typoLayer(x = test_geom2 , var = "cats",
           # col = carto.pal(pal1 = "blue.pal", pal2 = "red.pal", n1 = 3, n2 = 3),
           col = couleurs[1:length(levels(test_geom2$cats))],
           border = NA,
           legend.pos = "topleft",
           legend.values.order = levels(test_geom2$cats),
           legend.title.txt = paste0("Indices de Moran significatifs\nsur la variable « ", variable, " »\n(pvalue < 0,05)"))


typoLayer(x = test_geom2, var = "COM_NOUV",
          legend.values.order = c("OUI", "NON"),
          col=c("red","blue"),
          border = NA,
          legend.pos = "topleft",
          legend.title.txt = "Communes fusionnantes")

# plot(test_geom2CN$geometry, col = NA, border = "black", lwd = 1, add = TRUE)

par(mar = c(0,0,0,0), mfrow = c(1,1))



# On regarde la différence entre les communes fusionnantes et les autres
tabcont <- table(test_geom2$cats, test_geom2$COM_NOUV)

print(tabcont) # En valeur absolue
print(round(100*prop.table(tabcont,margin=1),1)) # Pourcentages, le total se fait par lignes
# round(100*prop.table(tabcont,margin=),1) # Pourcentages, le total se fait sur l'ensemble de la population
print(round(100*prop.table(tabcont,margin=2),1)) # Pourcentages, le total se fait par colonnes

test<-chisq.test(tabcont)
# test$observed
# round(test$expected,1)
# round(test$residuals,2)
print(test)



  
}
## [1] "Not significant" "High-High"       "Low-Low"         "Low-High"       
## [5] "High-Low"        "Isolated"

##                  
##                     NON   OUI
##   Not significant 25521  2148
##   High-High        1553    27
##   Low-Low          5498   352
##   Low-High          937    30
##   High-Low          116    14
##   Isolated           12     0
##                  
##                     NON   OUI
##   Not significant  92.2   7.8
##   High-High        98.3   1.7
##   Low-Low          94.0   6.0
##   Low-High         96.9   3.1
##   High-Low         89.2  10.8
##   Isolated        100.0   0.0
##                  
##                    NON  OUI
##   Not significant 75.9 83.5
##   High-High        4.6  1.1
##   Low-Low         16.3 13.7
##   Low-High         2.8  1.2
##   High-Low         0.3  0.5
##   Isolated         0.0  0.0
## 
##  Pearson's Chi-squared test
## 
## data:  tabcont
## X-squared = 125.46, df = 5, p-value < 2.2e-16
## 
## [1] "Not significant" "High-High"       "Low-Low"         "Low-High"       
## [5] "High-Low"        "Isolated"

##                  
##                     NON   OUI
##   Not significant 24929  1921
##   High-High        2724   294
##   Low-Low          4425   235
##   Low-High         1188    97
##   High-Low          359    24
##   Isolated           12     0
##                  
##                     NON   OUI
##   Not significant  92.8   7.2
##   High-High        90.3   9.7
##   Low-Low          95.0   5.0
##   Low-High         92.5   7.5
##   High-Low         93.7   6.3
##   Isolated        100.0   0.0
##                  
##                    NON  OUI
##   Not significant 74.1 74.7
##   High-High        8.1 11.4
##   Low-Low         13.2  9.1
##   Low-High         3.5  3.8
##   High-Low         1.1  0.9
##   Isolated         0.0  0.0
## 
##  Pearson's Chi-squared test
## 
## data:  tabcont
## X-squared = 63.652, df = 5, p-value = 2.133e-12
## 
## [1] "Not significant" "High-High"       "Low-Low"         "Low-High"       
## [5] "High-Low"        "Isolated"

##                  
##                     NON   OUI
##   Not significant 24406  2117
##   High-High        1902    38
##   Low-Low          6576   374
##   Low-High          603    24
##   High-Low          138    18
##   Isolated           12     0
##                  
##                     NON   OUI
##   Not significant  92.0   8.0
##   High-High        98.0   2.0
##   Low-Low          94.6   5.4
##   Low-High         96.2   3.8
##   High-Low         88.5  11.5
##   Isolated        100.0   0.0
##                  
##                    NON  OUI
##   Not significant 72.6 82.3
##   High-High        5.7  1.5
##   Low-Low         19.5 14.5
##   Low-High         1.8  0.9
##   High-Low         0.4  0.7
##   Isolated         0.0  0.0
## 
##  Pearson's Chi-squared test
## 
## data:  tabcont
## X-squared = 155.87, df = 5, p-value < 2.2e-16
## 
## [1] "Not significant" "High-High"       "Low-Low"         "Low-High"       
## [5] "High-Low"        "Isolated"

##                  
##                     NON   OUI
##   Not significant 24796  2150
##   High-High        1661    34
##   Low-Low          6315   355
##   Low-High          741    21
##   High-Low          112    11
##   Isolated           12     0
##                  
##                     NON   OUI
##   Not significant  92.0   8.0
##   High-High        98.0   2.0
##   Low-Low          94.7   5.3
##   Low-High         97.2   2.8
##   High-Low         91.1   8.9
##   Isolated        100.0   0.0
##                  
##                    NON  OUI
##   Not significant 73.7 83.6
##   High-High        4.9  1.3
##   Low-Low         18.8 13.8
##   Low-High         2.2  0.8
##   High-Low         0.3  0.4
##   Isolated         0.0  0.0
## 
##  Pearson's Chi-squared test
## 
## data:  tabcont
## X-squared = 153.54, df = 5, p-value < 2.2e-16
## 
## [1] "Not significant" "High-High"       "Low-Low"         "Low-High"       
## [5] "High-Low"        "Isolated"

##                  
##                     NON   OUI
##   Not significant 25292  2180
##   High-High        2005    42
##   Low-Low          5495   302
##   Low-High          676    25
##   High-Low          157    22
##   Isolated           12     0
##                  
##                     NON   OUI
##   Not significant  92.1   7.9
##   High-High        97.9   2.1
##   Low-Low          94.8   5.2
##   Low-High         96.4   3.6
##   High-Low         87.7  12.3
##   Isolated        100.0   0.0
##                  
##                    NON  OUI
##   Not significant 75.2 84.8
##   High-High        6.0  1.6
##   Low-Low         16.3 11.7
##   Low-High         2.0  1.0
##   High-Low         0.5  0.9
##   Isolated         0.0  0.0
## 
##  Pearson's Chi-squared test
## 
## data:  tabcont
## X-squared = 161.05, df = 5, p-value < 2.2e-16
## 
## [1] "High-High" "Isolated"

##            
##               NON   OUI
##   High-High 33625  2571
##   Isolated     12     0
##            
##               NON   OUI
##   High-High  92.9   7.1
##   Isolated  100.0   0.0
##            
##             NON OUI
##   High-High 100 100
##   Isolated    0   0
## 
##  Pearson's Chi-squared test with Yates' continuity correction
## 
## data:  tabcont
## X-squared = 0.15665, df = 1, p-value = 0.6923
## 
## [1] "Not significant" "High-High"       "Low-Low"         "Low-High"       
## [5] "High-Low"        "Isolated"

##                  
##                     NON   OUI
##   Not significant 23706  1902
##   High-High        3974   279
##   Low-Low          4376   264
##   Low-High         1228   104
##   High-Low          341    22
##   Isolated           12     0
##                  
##                     NON   OUI
##   Not significant  92.6   7.4
##   High-High        93.4   6.6
##   Low-Low          94.3   5.7
##   Low-High         92.2   7.8
##   High-Low         93.9   6.1
##   Isolated        100.0   0.0
##                  
##                    NON  OUI
##   Not significant 70.5 74.0
##   High-High       11.8 10.9
##   Low-Low         13.0 10.3
##   Low-High         3.7  4.0
##   High-Low         1.0  0.9
##   Isolated         0.0  0.0
## 
##  Pearson's Chi-squared test
## 
## data:  tabcont
## X-squared = 22.554, df = 5, p-value = 0.0004106
## 
## [1] "Not significant" "High-High"       "Low-Low"         "Low-High"       
## [5] "High-Low"        "Isolated"

##                  
##                     NON   OUI
##   Not significant 25369  2177
##   High-High        1665    32
##   Low-Low          5741   323
##   Low-High          749    27
##   High-Low          101    12
##   Isolated           12     0
##                  
##                     NON   OUI
##   Not significant  92.1   7.9
##   High-High        98.1   1.9
##   Low-Low          94.7   5.3
##   Low-High         96.5   3.5
##   High-Low         89.4  10.6
##   Isolated        100.0   0.0
##                  
##                    NON  OUI
##   Not significant 75.4 84.7
##   High-High        4.9  1.2
##   Low-Low         17.1 12.6
##   Low-High         2.2  1.1
##   High-Low         0.3  0.5
##   Isolated         0.0  0.0
## 
##  Pearson's Chi-squared test
## 
## data:  tabcont
## X-squared = 144.26, df = 5, p-value < 2.2e-16
rm(variable, df_variable, lms, pvals, cats, lbls, num_levels, couleurs)

Cartographies

Sans lien direct avec l’effet de grappe, éléments de cartographie, qui sont développés dans le chapitre X de la thèse (utilisation du même Markdown pour limiter la création de multiples dépôts).

Cf. l’idée donnée ici : https://www.bnsp.insee.fr/ark:/12148/bc6p08tp83z/f1.pdf#page=2

Préparation des données

geom2011 <- st_read("data/geom.gpkg", layer = "geom2011", quiet = TRUE) 
geom_new <- st_read("data/geom.gpkg", layer = "geom_new", quiet = TRUE) 
geomfus2011 <- st_read("data/geom.gpkg", layer = "geomfus2011", quiet = TRUE) 
geomCN_new <- st_read("data/geom.gpkg", layer = "geomCN_new", quiet = TRUE)  
dep <- st_read("data/geom.gpkg", layer = "dep", quiet = TRUE)

# Métadonnées
# Liste toutes les variables disponiles
variables_dispo <- as.data.frame(read_excel("data-raw/meta.xlsx", sheet = "ind_target"))
# Liste les variables marquées dans le fichier meta_budgets.xlsx comme nous intéressant
target <- subset(variables_dispo, variable_selec == "X")

Les données socio-économiques qui décrivent les communes en géographies 2011 et 2021 sont ici importées. On commence par extraire les communes ayant participé à la création d’une commune nouvelle, appelées ici communes fusionnantes (datafus2011), les communes nouvelles, avec les géométries au 1er janvier 2021 et caractérisées par les données à la géométrie 2011 agrégées (dataCN_new), ainsi que les communes, à la géométrie 2011, qui n’ont pas participé à la création d’une commune nouvelle (dataNfus2011)

load("data/refdata.Rdata")
datafus2011 <- subset(df2011, COM_NOUV == "OUI")
dataCN_new <- subset(df_new, COM_NOUV == "OUI")
dataNfus2011 <- subset(df2011, COM_NOUV == "NON") 

Dans un certain nombre de cas, il sera utile d’avoir, dans un même objet, les données et les géométries. Les données sont ici jointes aux couches géographiques d’intérêt.

geom2011 <- merge(geom2011, df2011, by = "CODGEO")
geom_new <- merge(geom_new, df_new, by = "CODGEO_new")
geomCN_new <- merge(geomCN_new, dataCN_new, by = "CODGEO_new")
geomfus2011 <- merge(geomfus2011, datafus2011, by = "CODGEO")

En fonction de la taille démographique

# par(mfrow = c(1,1), mar=c(0,0,1.5,0))

# En fonction de la population de la commune fusionnante

choroLayer(x = geomfus2011 , var = "P09_POP",
           method = "quantile", nclass = 4,
           col = carto.pal(pal1 = "blue.pal", pal2 = "red.pal", n1 = 2, n2 = 2),
           border = NA,
           legend.pos = "topleft", legend.values.rnd = 2,
           legend.title.txt = "Nombre d'habitants (2009,\nregroupement par quartiles)")
plot(st_geometry(dep), add = TRUE, lwd = 0.3)


layoutLayer(title = " ",# "Communes fusionnantes (2011-2024)\nen fonction de leur nombre d'habitants",
            author = "G. Bideau, 2024",
            tabtitle = TRUE, frame = FALSE, col = "white", coltitle = "black",
            sources = "Sources : INSEE, IGN, 2024")

# On crée un tableau donnant, pour chaque département, la population moyenne des communes fusionnantes
tableau_dep <- as.data.frame(tapply(geomfus2011$P09_POP, INDEX = geomfus2011$CODE_DEPT, mean))
colnames(tableau_dep) <- c("moyenne_Cfus")
tableau_dep$median_Cfus <- tapply(geomfus2011$P09_POP, INDEX = geomfus2011$CODE_DEPT, median)
tableau_dep$CODE_DEPT <- row.names(tableau_dep)
tableau_dep$Nbr_Cfus <- table(geomfus2011$CODE_DEP)
tableau_dep <- merge(tableau_dep, dep[, c("CODE_DEPT", "LIBELLE")], by = "CODE_DEPT", all.x = TRUE, all.y = FALSE)

tableau_dep_tt <- as.data.frame(tapply(geom2011$P09_POP, INDEX = geom2011$CODE_DEPT, mean))
colnames(tableau_dep_tt) <- c("moyenne")
tableau_dep_tt$median <- tapply(geom2011$P09_POP, INDEX = geom2011$CODE_DEPT, median)
tableau_dep_tt$CODE_DEPT <- row.names(tableau_dep_tt)
tableau_dep <- merge(tableau_dep, tableau_dep_tt, by = "CODE_DEPT", all.x = TRUE, all.y = FALSE)

tableau_pr_publi <- subset(tableau_dep, tableau_dep$Nbr_Cfus > 40)
tableau_pr_publi <- tableau_pr_publi[order(-tableau_pr_publi$moyenne_Cfus),]

kable(tableau_pr_publi[, c("LIBELLE", "Nbr_Cfus", "moyenne_Cfus", "moyenne", "median_Cfus", "median")],
      col.names = c("Département", "Nombre de communes fusionnantes", "Population moyenne des communes fusionnantes", "Population communale moyenne", "Population médiane des communes fusionnantes", "Population communale médiane"), digits = 0)
Département Nombre de communes fusionnantes Population moyenne des communes fusionnantes Population communale moyenne Population médiane des communes fusionnantes Population communale médiane
76 Vendée 44 2455 2221 1283.0 1288.0
45 Maine-et-Loire 225 1339 2149 978.0 1030.0
46 Manche 206 1128 828 379.5 381.0
1 Ain 45 924 1405 351.0 756.0
68 Savoie 48 894 1348 443.5 549.0
73 Deux-Sèvres 73 862 1201 466.0 579.0
70 Seine-Maritime 48 849 1678 474.5 494.0
24 Eure 127 720 863 377.0 416.0
25 Eure-et-Loir 54 655 1056 423.5 430.0
12 Calvados 221 588 964 317.0 340.0
22 Doubs 43 587 884 373.0 255.5
14 Charente 64 579 870 356.5 387.0
21 Dordogne 78 571 740 270.5 359.0
57 Orne 150 474 579 236.0 244.0
80 Yonne 43 392 755 307.0 354.0
36 Jura 78 373 480 159.0 212.5
44 Lozère 50 303 417 179.0 181.0
# En fonction de la population de la commune nouvelle
choroLayer(x = geomCN_new , var = "P09_POP",
           method = "quantile", nclass = 4,
           col = carto.pal(pal1 = "blue.pal", pal2 = "red.pal", n1 = 2, n2 = 2),
           border = NA,
           legend.pos = "topleft", legend.values.rnd = 2,
           legend.title.txt = "Nombre d'habitants (2009,\nregroupement par quartiles)")
plot(st_geometry(dep), add = TRUE, lwd = 0.3)
plot(st_geometry(geomCN_new), add = TRUE, lwd = 0.2)

layoutLayer(title = "",# "Communes nouvelles (2011-2024)\nen fonction de leur nombre d'habitants",
            author = "G. Bideau, 2024",
            tabtitle = TRUE, frame = FALSE, col = "white", coltitle = "black",
            sources = "Sources : INSEE, IGN, 2024")

# On crée un tableau donnant, pour chaque département, la population moyenne des communes nouvelles
tableau_dep <- as.data.frame(tapply(geomCN_new$P09_POP, INDEX = geomCN_new$CODE_DEPT_new, mean))
colnames(tableau_dep) <- c("moyenne_CN")
tableau_dep$median_CN <- tapply(geomCN_new$P09_POP, INDEX = geomCN_new$CODE_DEPT_new, median)
tableau_dep$CODE_DEPT <- row.names(tableau_dep)
tableau_dep$Nbr_Cfus <- table(geomfus2011$CODE_DEP) # On garde le nombre de communes fusionnantes pour faciliter les comparaisons entre les deux tableaux
tableau_dep <- merge(tableau_dep, dep[, c("CODE_DEPT", "LIBELLE")], by = "CODE_DEPT", all.x = TRUE, all.y = FALSE)

tableau_dep_tt <- as.data.frame(tapply(geom_new$P09_POP, INDEX = geom_new$CODE_DEPT_new, mean))
colnames(tableau_dep_tt) <- c("moyenne")
tableau_dep_tt$median <- tapply(geom_new$P09_POP, INDEX = geom_new$CODE_DEPT_new, median)
tableau_dep_tt$CODE_DEPT <- row.names(tableau_dep_tt)
tableau_dep <- merge(tableau_dep, tableau_dep_tt, by = "CODE_DEPT", all.x = TRUE, all.y = FALSE)

tableau_pr_publi <- subset(tableau_dep, tableau_dep$Nbr_Cfus > 40)
tableau_pr_publi <- tableau_pr_publi[order(-tableau_pr_publi$moyenne_CN),]

kable(tableau_pr_publi[, c("LIBELLE", "Nbr_Cfus", "moyenne_CN", "moyenne", "median_CN", "median")],
      col.names = c("Département", "Nombre de communes nouvelles", "Population moyenne des communes nouvelles", "Population communale moyenne", "Population médiane des communes nouvelles", "Population communale médiane"), digits = 0)
Département Nombre de communes nouvelles Population moyenne des communes nouvelles Population communale moyenne Population médiane des communes nouvelles Population communale médiane
45 Maine-et-Loire 225 7922 4431 5631.5 1569.5
76 Vendée 44 6279 2457 3529.0 1421.0
46 Manche 206 4658 1120 2508.5 444.0
70 Seine-Maritime 48 4075 1768 3228.5 503.0
12 Calvados 221 3012 1289 1662.0 407.5
68 Savoie 48 2684 1506 2697.5 612.0
73 Deux-Sèvres 73 2621 1431 1442.5 691.0
24 Eure 127 2473 996 1385.0 444.0
57 Orne 150 2368 759 2138.5 274.0
1 Ain 45 2309 1502 898.5 799.5
25 Eure-et-Loir 54 2210 1166 1522.0 472.0
21 Dordogne 78 1857 819 1216.5 383.0
14 Charente 64 1685 971 1203.5 426.0
80 Yonne 43 1533 812 1067.0 381.0
22 Doubs 43 1401 923 1323.5 260.0
36 Jura 78 1039 529 825.5 235.0
44 Lozère 50 890 508 579.0 209.0

En fonction de la taille démographique, rapportée aux autres communes

On regarde la position des communes fusionnantes puis des communes nouvelles vis-à-vis des communes françaises

par(mfrow = c(1,2), mar=c(0,0,1.2,0))

# Création des données concernant les quantiles, mais en s'appuyant sur les données de l'ensemble des communes françaises
geomfus2011$P09_POP_quantiles <- as.factor(cut(geomfus2011$P09_POP,
                                     breaks=c(quantile(geom2011$P09_POP, probs=seq(0, 1, 1/6), na.rm = TRUE))))
geomCN_new$P09_POP_quantiles <- as.factor(cut(geomCN_new$P09_POP,
                                     breaks=c(quantile(geom_new$P09_POP, probs=seq(0, 1, 1/6), na.rm = TRUE))))

# En fonction de la population de la commune fusionnante

typoLayer(x = geomfus2011 , var = "P09_POP_quantiles",
          border = NA,
          legend.values.order = levels(geomfus2011$P09_POP_quantiles),
          col = carto.pal(pal1 = "blue.pal", pal2 = "red.pal", n1 = 3, n2 = 3),
          # col = carto.pal(pal1 = "red.pal", n1 = 5),
          legend.pos = "topleft",
          legend.title.txt = "Situation au sein\ndes quantiles des\ncommunes françaises")
plot(st_geometry(dep), add = TRUE, lwd = 0.3)


layoutLayer(title = "Communes fusionnantes (2011-2024)\nen fonction de leur nombre d'habitant",
            author = "G. Bideau, 2024",
            tabtitle = TRUE, frame = FALSE, col = "white", coltitle = "black",
            sources = "Sources : INSEE, IGN, 2024")


# En fonction de la population de la commune nouvelle
typoLayer(x = geomCN_new , var = "P09_POP_quantiles",
          col = carto.pal(pal1 = "blue.pal", pal2 = "red.pal", n1 = 3, n2 = 3),
          border = NA,
          legend.values.order = levels(geomCN_new$P09_POP_quantiles),
          legend.pos = "topleft",
          legend.title.txt = "Situation au sein\ndes quantiles des\ncommunes françaises")
plot(st_geometry(dep), add = TRUE, lwd = 0.3)
plot(st_geometry(geomCN_new), add = TRUE, lwd = 0.2)

layoutLayer(title = "Communes nouvelles (2011-2024)\nen fonction de leur nombre d'habitant",
            author = "G. Bideau, 2024",
            tabtitle = TRUE, frame = FALSE, col = "white", coltitle = "black",
            sources = "Sources : INSEE, IGN, 2024")

On voit bien que les communes nouvelles sont bien davantage dans la strate supérieure. Mais il ne faut pas croire non plus que seules de petites communes fusionnent, ce n’est pas le cas.

Bibliographie

Bellefon, Marie-Pierre de, Vincent Loonis, and Ronan Le Gleut. 2018. “Codifier La Structure de Voisinage.” In Manuel d’analyse Spatiale. Théorie Et Mise En Œuvre Pratique Avec R. Insee Méthodes n\(^\circ\)131, 33–50. https://www.insee.fr/fr/statistiques/fichier/3635442/imet131-f-chapitre-2.pdf.
Bellefon, Marie-Pierre de, and Bouayad-Agha Salima. 2018. “Indices d’autocorrélation Spatiale.” In Manuel d’analyse Spatiale. Théorie Et Mise En Œuvre Pratique Avec R. Insee Méthodes n\(^\circ\)131, 53–72. https://www.insee.fr/fr/statistiques/fichier/3635442/imet131-f-chapitre-2.pdf.
Bideau, Gabriel. 2019. Les communes nouvelles françaises (2010-2019) : Une réforme territoriale silencieuse.” Annales de Géographie 728 (4/2019): 57–85. https://www.cairn.info/revue-annales-de-geographie-2019-4-page-57.htm.